home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SCREEN.SWG / 0033_Screen I-O Routines.pas < prev    next >
Pascal/Delphi Source File  |  1993-10-28  |  3KB  |  101 lines
  1. {***********************************************************************}
  2. PROGRAM ScreenPortDemo;         { Sept 6/93, Greg Estabrooks.           }
  3. USES CRT;                       { LastMode,Clrscr.                      }
  4. CONST
  5.      Speed = 50;                { Define speed for moving screen portion}
  6.      {******** Change this to make the screen move faster/slower *******}
  7. TYPE
  8.         ScreenPort = RECORD
  9.                         ScreenSt :ARRAY[1..4000] OF BYTE;
  10.                         NumCols,
  11.                         NumRows  :BYTE;
  12.                      END;
  13.  
  14.         ScreenPtr = ^ScreenSet;
  15.         ScreenSet = ARRAY[1..50,1..80,0..1] OF BYTE;
  16.                         {  1..50 = Row,  0..79 = Col, 0 = Character,
  17.                                                       1 = Color Byte    }
  18. VAR
  19.         TextScreen     :SCREENPTR;
  20.         BaseOfScreen   :WORD;
  21.         BPort,
  22.         SPort          :ScreenPort;
  23.         Row,Colm       :WORD;
  24.  
  25. PROCEDURE SaveScrPort( Col1, Row1, Col2, Row2 :BYTE; VAR ScrP :SCREENPORT );
  26. VAR
  27.         LLength :BYTE;
  28.         Counter1,Counter2  :WORD;
  29. BEGIN
  30.   Counter2 := 1;
  31.   LLength := (2 * (Col2 - Col1))+2;
  32.   For Counter1 := Row1 To Row2 DO
  33.     BEGIN
  34.       Move(TextScreen^[Counter1,Col1,0],ScrP.ScreenST[Counter2],LLength);
  35.       Inc(Counter2,LLength);
  36.     END;
  37.   ScrP.NumCols := LLength;
  38.   ScrP.NumRows := Row2 - Row1;
  39. END;
  40.  
  41. PROCEDURE RestoreScrPort( Col,Row :BYTE; VAR ScrP :SCREENPORT );
  42. VAR
  43.    Counter1,Counter2  :WORD;
  44. BEGIN
  45.   Counter2 := 1;
  46.   For Counter1 := Row To (Row + ScrP.NumRows) Do
  47.     BEGIN
  48.       Move(ScrP.ScreenST[Counter2],TextScreen^[Counter1,Col,0],ScrP.NumCols);
  49.       Inc(Counter2,ScrP.NumCols);
  50.     END;
  51. END;
  52.  
  53. BEGIN
  54.   IF LastMode = 7 THEN          { Check current video mode.             }
  55.     BaseOfScreen := $B000       { If Monochrome load mono segment.      }
  56.   ELSE
  57.     BaseOfScreen := $B800;      { if not load color segment.            }
  58.   TextScreen := Ptr(BaseOfScreen,0); { Now point TextScreen proper area.}
  59.  
  60.   SaveScrPort(10,5,20,15,BPort);{ Save a cleared part of the screen.    }
  61.   GotoXY(1,1);                  { Move to top corner of screen.         }
  62.  
  63.   FOR Row := 1 to 20 DO         { Generate screen for demonstration.    }
  64.     FOR Colm := 1 to 80 DO
  65.        Write('A');
  66.  
  67.   SaveScrPort(10,5,20,15,SPort);{ Save a portion of the screen.         }
  68.   ClrScr;                       { Clear the screen.                     }
  69.   SaveScrPort(10,5,20,15,BPort);{ Redisplay saved portion.              }
  70.  
  71.   FOR Colm := 10 to 50 DO       { Animate portion right.                }
  72.    BEGIN
  73.      RestoreScrPort(Colm,5,SPort);
  74.      Delay(Speed);
  75.      RestoreScrPort(Colm,5,BPort);
  76.    END;
  77.  
  78.   FOR Row := 5 to 14 DO         { Animate Portion Down.                 }
  79.    BEGIN
  80.      RestoreScrPort(50,Row,SPort);
  81.      Delay(Speed);
  82.      RestoreScrPort(50,Row,BPort);
  83.    END;
  84.  
  85.   FOR Colm := 50 DOWNTO 10 DO   { Animate Portion Left.                 }
  86.    BEGIN
  87.      RestoreScrPort(Colm,14,SPort);
  88.      Delay(Speed);
  89.      RestoreScrPort(Colm,14,BPort);
  90.    END;
  91.  
  92.   FOR Row := 14 DOWNTO 5 DO     { Animate Portion Up.                   }
  93.    BEGIN
  94.      RestoreScrPort(10,Row,SPort);
  95.      Delay(Speed);
  96.      RestoreScrPort(10,Row,BPort);
  97.    END;
  98.    RestoreScrPort(10,5,SPort);
  99.   Readln;
  100. END.
  101. {***********************************************************************}